PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/picklst.exe/DIALOGS1.PAS

Pascal/Delphi Source File | 1991-07-26 | 12.7 KB | 472 lines

unit Dialogs1;

{************************************************}
{                                                }
{   Turbo Pascal 6.0                             }
{   Turbo Vision Unit - Dialogs1                 }
{                                                }
{   Containing:                                  }
{   tSelectItem, tSelectCollection,              }
{   tPickList, tPickDialog                       }
{   tTextDialog                                  }
{                                                }
{************************************************}
{********************************}
{***Programmed by             ***}
{***Blake Watson              ***}
{***CIS number 70303,373      ***}
{********************************}
interface

uses Objects, Drivers, Dialogs, Views, MsgBox, App,
     Objects1;

const
   MaxRows = 21;

type
   pSelectItem = ^tSelectItem;
   tSelectItem = object(tObject)
      Name    : pString;
      Selected: boolean;
      constructor Init(S:String);
      destructor Done; virtual;
      end;

   pSelectCollection = ^tSelectCollection;
   tSelectCollection = object(tCollection)
      Pick: byte;
      constructor Init(S:string);
      function NameAt(I:Integer): string;
      procedure NewItem(S:String); virtual;
      function Selected(I:Integer): boolean;
      procedure ToggleAt(I:Integer);
      procedure DropNotSelected;
      function LastSelectedItem: integer;
      function NumberSelected: integer;
      end;

   pPickList = ^tPickList;
   tPickList = object(tView)
      List  : PSelectCollection;
      MaxItemLength, Picked, Highlight, NumRows,
      NumCols: integer;
      constructor Init(r: tRect; MIL, NC, NR: integer; AList: pSelectCollection);
      procedure Draw; virtual;
      procedure Choose(AnItem: Integer); virtual;
      procedure HandleEvent(var Event:tEvent); virtual;
      end;

   pPickDialog = ^tPickDialog;
   tPickDialog = object(tDialog)
      constructor Init(AList: pointer; X,Y: Integer);
      procedure GetDims(var r: tRect; var W, Columns, rows: integer; Alist: pSelectCollection);
      end;

   {tPickDialog is the first "useful" object.  Pass a tRect, a width, number of
    columns and rows, and a TSelectCollection, and it will allow the user to
    select up to <pick> items, marking the <selected> field of those items.}

   pTextDialog = ^tTextDialog;
   tTextDialog = object(tPickDialog)
      IsValid : boolean;
      List    : pSelectCOllection;
      constructor Init(var AList: pointer; X,Y: Integer; fn: string; name: string);
      function LoadList(var fn, name, h: string; var temp: pCollection): boolean;
      procedure InitList(h:string; t:pCollection); virtual;
      function Valid(Command: Word): Boolean; virtual;
      destructor Done; virtual;
      end;

   {tTextDialog is a little more complex.  You pass an empty TSelectCollection,
    the coords for where the list should appear, and it figures out how large
    the dialog has to be.  The TSelectCollection is built from a list (spec'ed
    by <name>) in a text file <fn>.

    The text file may have many lists in it, and follows this format:

    NumberOfItems,ListName,NumberToPick
    Item
    Item
    ....
    NumberOfItems,ListName,NumberToPick
    ....

    tTextDialog returns ONLY the items that have been selected.}

function GetElement(S:String; N:byte): string;
function GetNumericElement(S:String; N:byte): longint;

implementation

function GetElement(S:String; N:byte): string;
var I,J,K: byte;
begin
   I := 1; J := 0;
   while(pos(',',S)>0) and (I<>N) do
   begin
      J := pos(',',s);
      inc(I);
      s[j] := ' ';
      end;
   If I<>N then GetElement := ''
   else begin
      inc(J);
      K := pos(',',S);
      If K = 0 then K := Length(S) + 1;
      GetElement := copy(S,J,K-J);
      end;
   end;

function GetNumericElement(S:String; N:byte): longint;
var l:longint; code:integer;
begin
   s := GetElement(S,N);
   val(s,l,code);
   GetNumericElement := l;
   end;

{tSelectItem}

constructor tSelectItem.Init(S:String);
var w: byte;
begin
   tObject.Init;
   w := pos('  ',s);
   if w = 0 then w := length(S);
   Name := newStr(copy(S,1,w));
   selected := false;
   end;

destructor tSelectItem.Done;
begin
   DisposeStr(Name);
   end;

{tSelectCollection}

constructor tSelectCollection.Init(S:String);
begin
   tCollection.Init(GetNumericElement(s,1),0);
   Pick := GetNumericElement(s,3);
   If Pick = 0 then Pick := 1;
   end;

function tSelectCollection.NameAt(I: Integer): string;
begin
   NameAt := tSelectItem(At(I)^).Name^;
   end;

function tSelectCollection.Selected(I: Integer): boolean;
begin
   Selected := tSelectItem(At(I)^).Selected;
   end;

procedure tSelectCollection.ToggleAt(I: Integer);
begin
   tSelectItem(At(I)^).Selected := not tSelectItem(At(I)^).Selected;
   end;

procedure tSelectCollection.DropNotSelected;
var I: Integer;
begin
   for I := Count-1 downto 0 do
      if not tSelectItem(At(I)^).Selected
         then Free(At(I));
   end;

procedure tSelectCollection.NewItem(S:string);
begin
   Insert(New(pSelectItem, init(S)));
   end;

function tSelectCollection.LastSelectedItem: integer;
var I: integer;
begin
   I := Count;
   repeat dec(i) until (I=0) or Selected(I);
   LastSelectedItem := I;
   end;

function tSelectCollection.NumberSelected: integer;
var I, J: integer;
begin
   J := 0;
   for I := 0 to Count -1 do
       if Selected(I) then inc(J);
   NumberSelected := J;
   end;


{tPICKLIST}

constructor tPickList.Init;
var I : integer;
    p : pointer;
begin
   tview.init(R);
   EventMask := EventMask or evMouseMove;
   Options := ofSelectable or ofTopSelect or ofPreProcess or ofCentered;

   List := AList;
   MaxItemLength := MIL;
   NumCols := NC;
   NumRows := NR;
   picked := 0;
   for I := 0 to List^.Count -1 do
      if List^.Selected(I) then inc(picked);

   end;

procedure tPickList.Draw;
var I, X, Y : byte;
    s       : string;
begin
   X := 0; Y := 0;
   for I := 0 to List^.Count-1 do
   begin
      If Y + 1 > NumRows then
      begin
         Y := 0;
         Inc(X, MaxItemLength);
         end;
                           {This code guarantees that s fills all space}
      S := List^.NameAt(I);
      while(Length(S)<MaxItemLength) do s := S + ' ';

      if I = Highlight then writeStr(X, Y, s, 11)
      else if List^.Selected(I) then writeStr(X,Y,S,3)
      else writeStr(x,y,S,1);
      Inc(y);
      end;

   S := '';
   while(Length(S)<MaxItemLength) do s := S + ' ';
   while(Y<=NumRows) do
   begin
      writestr(X,Y,S,1);
      inc(y);
      end;

   end;

procedure tPickList.Choose(AnItem: Integer);
begin
   If tSelectItem(List^.At(AnItem)^).Selected then dec(picked)
   else inc(picked);
   tSelectItem(List^.At(AnItem)^).Selected :=
      not tSelectItem(List^.At(AnItem)^).Selected;
   end;

procedure tPickList.HandleEvent;
var CoOrds: TPoint;
    OH,I,J: integer;
    r     : tRect;
    P     : Pview;
    s     : string;
begin
   tView.HandleEvent(Event);
   If Event.What and (evBroadCast or evCommand) = 0 then
   begin
      Oh := Highlight;
      if (event.What and evKeyboard <> 0) then
      begin
         case event.KeyCode of
            kbDown : Inc(Highlight);
            kbUp   : Dec(Highlight);
            kbRight: if numcols>1 then inc(Highlight,NumRows);
            kbLeft : if numcols>1 then dec(Highlight,NumRows);
            else
               if Event.CharCode in [' ',#13] then
               begin
                 If (Event.charCode = ' ') or not List^.Selected(Highlight)
                 then Choose(Highlight);
                 if Event.CharCode = #13 then picked := List^.pick;
                 end
            else begin
               I := Highlight; J := 0;
               repeat
                  inc(I); Inc(J);
                  If I = List^.Count then I := 0;
                  If I < List^.Count then S := List^.NameAt(I);
                  until(Upcase(Event.CharCode)=s[1]) or (List^.Count=J);
               If J<=List^.Count then
               begin
                  highlight := I;
                  choose(Highlight);
                  end;
               end;
            end;
         If Highlight = -1 then highlight := List^.Count-1
         else If Highlight < -1 then Highlight := 0
         else if Highlight = List^.Count then Highlight := 0
         else if Highlight > List^.Count then Highlight := List^.Count-1;
         end
      else if (event.What and evMouse <> 0) and MouseInView(Event.Where) then
      begin
         MakeLocal(Event.Where,CoOrds);
         Highlight := CoOrds.Y;
         If (NumCols > 0) and (CoOrds.x + 1> MaxItemLength) then
         while Coords.x + 1> MaxItemLength do
         begin
            dec(coords.x, MaxItemLength);
            Inc(highLight, NumRows);
            end;
         If Highlight >= List^.Count then Highlight := List^.Count-1;
         if (Event.What and evMouseDown <> 0) then
         begin
            If (Event.Buttons = mbLeftButton) or not List^.Selected(Highlight)
               then Choose(Highlight);
            if Event.Buttons = mbRightButton then Picked := List^.Pick;
            end;
         end;
      If Event.CharCode<>#27 then ClearEvent(Event);
      If Picked = List^.Pick then p := Message(Owner, evCommand, cmOK, nil)
      else If OH<>Highlight then DrawView;
      end;
   end;

{tPickDialog}

constructor tPickDialog.Init;
var Int: pPickList;
    Rows, W, Columns, TotalWidth
     : Integer;
    r: tRect;
begin
   GetDims(r, W, Columns, rows, Alist);

   r.a.x := X; r.a.y := y;
   inc(r.b.x,x); inc(r.b.y,y);

   while r.b.x >= ScreenWidth do r.Move(-1,0);
   while r.b.y >= ScreenHeight do r.Move(0, -1);

   tDialog.Init(r,'');
   state := state and not sfShadow;
   r.grow(-1, -1);;
   Insert(New(pPickList, Init(r, W, columns, rows, Alist)));
   end;

procedure tPickDialog.GetDims;
var TotalWidth,
    I: byte;
begin
   w := 0; Columns := 1; Rows := AList^.Count;

   for I := 0 to Rows-1 do
      if Length(AList^.NameAt(I)) > w then
         w := length(AList^.NameAt(I));
   I := Rows;
   Inc(W);
   TotalWidth := W;
   while I> MaxRows do
   begin
      Inc(Columns);
      Inc(TotalWidth,W);
      I := (Rows div Columns);
      If Rows mod columns <> 0 then inc(I);
      end;
   Rows := I;
   If TotalWidth < 14 then TotalWidth := 14;
   while W*Columns < 14 do inc(w);

   r.assign(0,0,totalwidth+2, rows+2);
   end;

{tTextDialog}

constructor tTextDialog.init;
var h: string;
    temp   : pCollection;
begin
    IsValid := false;
    If LoadList(fn, name,h, temp) then
    begin
      InitList(H, Temp);
      dispose(temp, done);
      AList := list;
      tPickDialog.Init(List,X,Y);   (*list gets zeroed out here*)
      list := AList;
      IsValid := true;
      end;
   end;

function tTextDialog.LoadList(var fn, name, h: string; var Temp: pCollection): boolean;
var f   : text;
    w   : word;
    NumToPick,
    n, I   : integer;
    s, t   : string;
begin
   LoadList := false;
   assign(f,fn);
   {$I-}
   reset(F);
   {$I+}
   If IoResult<>0 then begin
      w := MessageBox('Unable to open file '+fn+'.',nil,mfError+mfCancelButton);
      done;
      end
   else begin
      readln(f,s);
      n := getNumericElement(s,1);
      t := getElement(s,2);
      while(t<>name) and not eof(F) do
      begin
         for i := 1 to n do readln(f,s);
         readln(f,s);
         t := getElement(s,2);
         n := getNumericElement(s,1);
         end;
      if t<>name then begin
         w := MessageBox('Unable to find list '+name+'.',nil,mfError+mfCancelButton);
         n := 0;
         done;
         end
      else if n = 0 then begin
         w := MessageBox('No pick number in list '+name+'.',nil,mfError+mfCancelButton);
         done;
         end
      else begin
         h := s;
         temp := new(pCollection, init(n,0));
         for I := 1 to Temp^.Limit do
         begin
            readln(f,s);
            Temp^.Insert(New(pStrObj, Init(S)));
            end;
         system.close(f);
         LoadList := true;
         end;
      end;
   end;


function tTextDialog.Valid(Command: Word): Boolean;
begin
   If (Command = 0) and not IsValid then Valid := False
   else Valid := true;
   end;

procedure tTextDialog.InitList(h:string; t:pCollection);
var p: pSelectCollection;
    i: integer;
begin
   p := New(pSelectCollection, init(H));
   for I := 0 to t^.Limit-1 do
      p^.NewItem(tStrObj(t^.at(i)^).p^);
   List := P;
   end;

destructor tTextDialog.done;
begin
   List^.DropNotSelected;
   IsValid := false;
   tPickDialog.Done;
   end;

   end.